home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 003 / chrchpr2.arc / CSQUESTS.CMD < prev    next >
Encoding:
Text File  |  1979-12-31  |  4.5 KB  |  208 lines
  1. * Program CSQUESTS - Enables operator entry of Survey questions
  2. If msel='2'
  3.  Select secondary
  4.  Accept 'Do you want a new, clear questions file?  [Y/N] ' to xx
  5.  If !(xx)='Y'
  6.   Use CSURVEYX
  7.   Copy to CSURVEY
  8.   Use CSURVEY
  9.   Store 0 to II
  10.   Do while II<68
  11.     Store II+1 to II
  12.     Append blank
  13.   enddo
  14.   ? 'A clear CSURVEY file has now been made on the program disk.'
  15.   GOTO 2
  16.   If @(!(D),'ABCDEFGHI')<>0
  17.     Replace QU1 with $(qu1,1,11)+!(D)
  18.   endif
  19. endif
  20. Use CSURVEY
  21. GOTO 10
  22. Store 1 to II
  23. Store '11' to SET
  24. Store F to DONE
  25. @ 18,1 say chname+' - CSURVEY Questions Entry        '+curdate
  26. @ 19,10 say 'The current valid answer set is ' get csanswrsx
  27. @ 20,10 say 'TITLE1 ' get QU1
  28. @ 21,10 say 'TITLE2 ' get QU2
  29. @ 22,10 say 'TITLE3 ' get QU3
  30. ? ' Press ctrl-W to complete entries'
  31. READ
  32. Store trim(csanswrsx)+' ' to valansw
  33. Do while .not.DONE
  34. Erase
  35. @ 1,1 say chname+' - CSURVEY Questions Entry     '+curdate
  36. @ 3,20 say 'VALID SURVEY ANSWERS: >'+valansw+'<'
  37. Store 1 to cl
  38. Store 'A' to I
  39. Store val(SET)-11 to III
  40. GOTO &SET
  41.   Store str(1+III,2)+'. ' to xx
  42.   @ 5,1 say 'QUESTION '+xx get QU1
  43.   @ 6,14 get QU2
  44.   @ 7,14 get QU3
  45.   @ 9,1 say 'VALID ANSWERS'
  46.   @ 9,14  get AN1
  47.   @ 10,14 get AN2
  48.   @ 11,14 get AN3
  49.   @ 12,14 get AN4
  50.   @ 13,14 get AN5
  51.   @ 14,14 get AN6
  52.   @ 15,14 get AN7
  53.   @ 16,14 get AN8
  54.   READ
  55. Accept 'Select:  [N]ext question   [B]ack a question   [S]ave   [Q]uit ' to es
  56. Store T to inval2
  57. Do while inval2
  58.   Store F to inval2
  59.   Do CASE
  60.   CASE !(es)='N' .or. !(es)='B' .or. !(es)='S'
  61.     Store '1' to I
  62.     Store $(AN1,1,1) to answ
  63.     Do while I<>'8'
  64.       Store str(val(I)+1,1) to I
  65.       Store answ+$(AN&I,1,1) to ANSW
  66.     enddo
  67.     Replace CSANSWRSX with ANSW
  68.     If !(es)='N'
  69.       If SET='70'
  70.         Accept 'Invalid entry. This is the last screen. Enter again ' to es
  71.         Store T to inval2
  72.       else
  73.         Store str(val(SET)+1,2) to SETT
  74.       endif
  75.     else
  76.       If SET='11'
  77.         Accept 'Invalid entry. This is the first screen. Enter again ' to es
  78.         Store T to inval2
  79.       else
  80.         Store str(val(SET)-1,2) to SETT
  81.       endif
  82.     endif
  83.     If .not. inval2
  84.       Store SETT to SET
  85.     endif
  86.     If !(ES)='S'
  87.       GOTO &SET
  88.       Store T to DONE
  89.     endif
  90.   CASE !(ES)='Q'
  91.     Store T to DONE
  92.   otherwise
  93.     Accept 'Invalid entry. Please enter again ' to es
  94.     Store T to inval2
  95.   ENDCASE
  96.   ENDDO
  97.  enddo
  98. else 
  99.  Select secondary
  100.  Use CSURVEY
  101.  GOTO 10
  102. ? 'Now printing the survey form for the following function -'
  103. ? '  ',qu1
  104. ? '  ',qu2
  105. ? '  ',qu3
  106. ?
  107. Store trim(qu1) to qux
  108. If len(qux)<50
  109.   Store '        '+qux to qux
  110. endif
  111. SKIP
  112. Set format to print
  113. Store 0 to pag
  114. Store 99 to cl
  115. Store ' 1' to QUN
  116. Do while qu1<>'                    '
  117.   If cl>54
  118.     If cl<99
  119.       EJECT
  120.     endif
  121.     Store pag+1 to pag
  122.     @ 1,0 say qux
  123.     @ 1,63 say curdate
  124.     If cl=99
  125.       @ 2,10 say qu2
  126.     endif
  127.     @ 2,70 say 'Page'+str(pag,3)
  128.     If cl=99
  129.       @ 3,10 say qu3
  130.       @ 4,1 say 'NAME: ____________________________________________________'
  131.       Store 7 to cl
  132.     else
  133.       Store 4 to cl
  134.     endif
  135.   endif
  136.   @ cl-1,1 say QUN+'. '+qu1
  137.   If qu2<>'    '
  138.     @ cl,5 say qu2
  139.     Store cl+1 to cl
  140.     If qu3<>'    '
  141.       @ cl,5 say qu3
  142.       Store cl+1 to cl
  143.     endif
  144.   endif
  145.   Store '1' to I
  146.   Store T to twocolm
  147.   Do while AN&I<>'              '.and.I<>'9'
  148.     If len(trim(AN&I)) > 25
  149.       Store F to  twocolm
  150.     endif
  151.     Store str(val(I)+1,1) to I
  152.   enddo
  153.   Store '0' to II
  154.   If twocolm
  155.     Store str(val(I)/2,1) to I
  156.     Store I to IM
  157.     Do while II<>I
  158.       Store str(val(II)+1,1) to II
  159.       Store str(val(IM)+1,1) to IM
  160.       Store trim(AN&II) to ANII
  161.       Store trim(AN&IM) to ANIM
  162.       @ cl,7 say ANII
  163.       @ cl,40 say ANIM
  164.       Store cl+1 to cl
  165.     enddo
  166.   else
  167.     Store '0' to II
  168.     Do while II<>I
  169.       Store str(val(II)+1,1) to II
  170.       @ cl,7 say trim(AN&II)
  171.       Store cl+1 to cl
  172.     enddo
  173.   endif
  174.   SKIP
  175.   Store str(val(QUN)+1,2) to QUN
  176.   Store cl+2 to cl
  177. enddo
  178. @ cl,0 say '.'
  179. EJECT
  180. Set format to screen
  181. USE
  182. Select primary
  183. endif
  184. RETURN
  185.  
  186. 
  187. USE
  188. Select primary
  189. endif
  190. RETURN
  191.  
  192. ant a new, clear questions file?  [Y/N] ' to xx
  193.  If !(xx)='Y'
  194.   Use CSURVEYX
  195.   Copy to CSURVEY
  196.   Use CSURVEY
  197.   Store 0 to II
  198.   Do while II<68
  199.     Store II+1 to II
  200.     Append blank
  201.   enddo
  202.   ? 'A clear CSURVEY file has now been made on the program disk.'
  203.   Accept 'Enter data disk letter ' to D
  204.   GOTO 2
  205.   If @(!(D),'ABCDEFGHI')<>0
  206.     Replace QU1 with $(qu1,1,11)+!(D)
  207.   endif
  208. endif